home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / Select.tcl.z / Select.tcl
Encoding:
Text File  |  1999-01-26  |  6.9 KB  |  296 lines
  1. # Select.tcl --
  2. #
  3. #    Implement the tixSelect widget.
  4. #
  5. # Copyright (c) 1996, Expert Interface Technologies
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10.  
  11. tixWidgetClass tixSelect {
  12.     -superclass tixLabelWidget
  13.     -classname  TixSelect
  14.     -method {
  15.     add button invoke
  16.     }
  17.     -flag {
  18.     -allowzero -buttontype -command -disablecallback -orientation
  19.     -orient -padx -pady -radio -selectedbg -state -validatecmd
  20.     -value -variable
  21.     }
  22.     -forcecall {
  23.     -variable -state
  24.     }
  25.     -static {
  26.     -allowzero -orientation -padx -pady -radio
  27.     }
  28.     -configspec {
  29.     {-allowzero allowZero AllowZero 0 tixVerifyBoolean}
  30.     {-buttontype buttonType ButtonType button}
  31.     {-command command Command ""}
  32.     {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
  33.     {-orientation orientation Orientation horizontal}
  34.     {-padx padx Pad 0}
  35.     {-pady pady Pad 0}
  36.     {-radio radio Radio 0 tixVerifyBoolean}
  37.     {-selectedbg selectedBg SelectedBg gray}
  38.     {-state state State normal}
  39.     {-validatecmd validateCmd ValidateCmd ""}
  40.     {-value value Value ""}
  41.     {-variable variable Variable ""}
  42.     }
  43.     -alias {
  44.     {-orient -orientation}
  45.     }
  46.     -default {
  47.     {*frame.borderWidth            1}
  48.     {*frame.relief                sunken}
  49.     {*Button.borderWidth            2}
  50.     {*Button.highlightThickness        0}
  51.     }
  52. }
  53.  
  54. proc tixSelect:InitWidgetRec {w} {
  55.     upvar #0 $w data
  56.  
  57.     tixChainMethod $w InitWidgetRec
  58.     set data(items)    ""
  59.     set data(buttonbg) ""
  60.     set data(varInited)      0
  61. }
  62.  
  63. #----------------------------------------------------------------------
  64. #                           CONFIG OPTIONS
  65. #----------------------------------------------------------------------
  66. proc tixSelect:config-state {w arg} {
  67.     upvar #0 $w data
  68.  
  69.     if {$arg == "disabled"} {
  70.     foreach item $data(items) {
  71.         $data(w:$item) config -state disabled -relief raised \
  72.         -bg $data(buttonbg)
  73.     }
  74.     if ![info exists data(labelFg)] {
  75.         set data(labelFg) [$data(w:label) cget -foreground]
  76.         catch {
  77.         $data(w:label) config -fg [tix option get disabled_fg]
  78.         }
  79.     }
  80.     } else {
  81.     foreach item $data(items) {
  82.         if {[lsearch $data(-value) $item] != -1} {
  83.         # This button is selected
  84.         #
  85.         $data(w:$item) config -relief sunken -bg $data(-selectedbg) \
  86.             -state normal
  87.         } else {
  88.         $data(w:$item) config -relief raised -bg $data(buttonbg) \
  89.             -command "$w invoke $item" -state normal
  90.         }
  91.     }
  92.     if [info exists data(labelFg)] {
  93.         catch {
  94.         $data(w:label) config -fg $data(labelFg)
  95.         }
  96.         unset data(labelFg)
  97.     }
  98.     }
  99.  
  100.     return ""
  101. }
  102.  
  103. proc tixSelect:config-variable {w arg} {
  104.     upvar #0 $w data
  105.  
  106.     set oldValue $data(-value)
  107.  
  108.     if [tixVariable:ConfigVariable $w $arg] {
  109.     # The value of data(-value) is changed if tixVariable:ConfigVariable 
  110.     # returns true
  111.     set newValue $data(-value)
  112.     set data(-value) $oldValue
  113.     tixSelect:config-value $w $newValue
  114.     }
  115.     catch {
  116.     unset data(varInited)
  117.     }
  118.     set data(-variable) $arg
  119. }
  120.  
  121. proc tixSelect:config-value {w value} {
  122.     upvar #0 $w data
  123.  
  124.     # sanity checking
  125.     #
  126.     foreach item $value {
  127.     if {[lsearch $data(items) $item] == "-1"} {
  128.         error "subwidget \"$item\" does not exist"
  129.     }
  130.     }
  131.  
  132.     tixSelect:SetValue $w $value
  133. }
  134.  
  135. #----------------------------------------------------------------------
  136. #                     WIDGET COMMANDS
  137. #----------------------------------------------------------------------
  138. proc tixSelect:add {w name args} {
  139.     upvar #0 $w data
  140.  
  141.     set data(w:$name) [eval $data(-buttontype) $data(w:frame).$name -command \
  142.      [list "$w invoke $name"] -takefocus 0 $args]
  143.  
  144.     if {$data(-orientation) == "horizontal"} {
  145.     pack $data(w:$name) -side left -expand yes -fill y\
  146.         -padx $data(-padx) -pady $data(-pady)
  147.     } else {
  148.     pack $data(w:$name) -side top -expand yes  -fill x\
  149.         -padx $data(-padx) -pady $data(-pady)
  150.     }
  151.  
  152.     if {$data(-state) == "disabled"} {
  153.     $data(w:$name) config -relief raised -state disabled
  154.     }
  155.  
  156.     # find out the background of the buttons
  157.     #
  158.     if {$data(buttonbg) == ""} {
  159.     set data(buttonbg) [lindex [$data(w:$name) config -background] 4]
  160.     
  161.     }
  162.  
  163.     lappend data(items) $name
  164. }
  165.  
  166. # Obsolete command
  167. #
  168. proc tixSelect:button {w name args} {
  169.     upvar #0 $w data
  170.  
  171.     if {$args != ""} {
  172.     return [eval $data(w:$name) $args]
  173.     } else {
  174.     return $w.$name
  175.     }
  176. }
  177.  
  178. # This is called when a button is invoked
  179. #
  180. proc tixSelect:invoke {w button} {
  181.     upvar #0 $w data
  182.  
  183.     if {$data(-state) != "normal"} {
  184.     return
  185.     }
  186.  
  187.     set newValue $data(-value)
  188.  
  189.     if {[lsearch $data(-value) $button] != -1} {
  190.     # This button was selected
  191.     #
  192.         if {[llength $data(-value)] > 1 || [tixGetBoolean $data(-allowzero)]} {
  193.  
  194.         # Take the button from the selected list
  195.         #
  196.         set newValue ""
  197.         foreach item $data(-value) {
  198.         if {$item != $button} {
  199.             lappend newValue $item
  200.         }
  201.         }
  202.     }
  203.     } else {
  204.     # This button was not selected
  205.     #
  206.     if [tixGetBoolean $data(-radio)] {
  207.         # The button become the sole item in the list
  208.         #
  209.         set newValue [list $button]
  210.     } else {
  211.         # Add this button into the list
  212.         #
  213.         lappend newValue $button
  214.     }
  215.     }
  216.  
  217.     if {$newValue != $data(-value)} {
  218.     tixSelect:SetValue $w $newValue
  219.     }
  220. }
  221.  
  222. #----------------------------------------------------------------------
  223. #                Private functions
  224. #----------------------------------------------------------------------
  225. proc tixSelect:SetValue {w newValue {noUpdate 0}} {
  226.     upvar #0 $w data
  227.  
  228.     set oldValue $data(-value)
  229.  
  230.     if {$data(-validatecmd) != ""} {
  231.        set data(-value) [tixEvalCmdBinding $w $data(-validatecmd) "" $newValue]
  232.     } else {
  233.     if {[tixGetBoolean $data(-radio)] && [llength $newValue] > 1} {
  234.         error "cannot choose more than one items in a radio box"
  235.     }
  236.  
  237.     if {![tixGetBoolean $data(-allowzero)] && [llength $newValue] == 0} {
  238.         error "empty selection not allowed"
  239.     }
  240.  
  241.     set data(-value) $newValue
  242.     }
  243.  
  244.     if {! $noUpdate} {
  245.     tixVariable:UpdateVariable $w
  246.     }
  247.  
  248.     # Reset all to be unselected
  249.     #
  250.     foreach item $data(items) {
  251.     if {[lsearch $data(-value) $item] == -1} {
  252.         # Is unselected
  253.         #
  254.         if {[lsearch $oldValue $item] != -1} {
  255.         # was selected
  256.         # -> popup the button, call command
  257.         #
  258.         $data(w:$item) config -relief raised -bg $data(buttonbg)
  259.         tixSelect:CallCommand $w $item 0
  260.         }
  261.     } else {
  262.         # Is selected
  263.         #
  264.         if {[lsearch $oldValue $item] == -1} {
  265.         # was unselected
  266.         # -> push down the button, call command
  267.         #
  268.         $data(w:$item) config -relief sunken -bg $data(-selectedbg)
  269.         tixSelect:CallCommand $w  $item 1
  270.         }
  271.     }
  272.     }
  273. }
  274.  
  275. proc tixSelect:CallCommand {w name value} {
  276.     upvar #0 $w data
  277.  
  278.     if {!$data(-disablecallback) && $data(-command) != ""} {
  279.     if {![info exists data(varInited)]} {
  280.         set bind(specs) "name value"
  281.         set bind(name)  $name
  282.         set bind(value) $value
  283.         tixEvalCmdBinding $w $data(-command) bind $name $value
  284.     }
  285.     }
  286. }
  287.  
  288. proc tixSelect:Destructor {w} {
  289.  
  290.     tixVariable:DeleteVariable $w
  291.  
  292.     # Chain this to the superclass
  293.     #
  294.     tixChainMethod $w Destructor
  295. }
  296.